Introduction.
Last week we have created a new Wrapper Class ClsTiles, using the ClsArea Class twice in the new Class Module, one instance for Floor dimension values, and the second instance for Floor-Tile dimension, to calculate the number of Tiles for the room.
In the new Wrapper Class Module, we will transform the Volume Class (ClsVolume2) into the Sales (ClsSales) Class. With some cosmetic changes, we will give it a total face-lift in the Wrapper Class, hiding its true identity as a Volume calculation Class, and use it for calculating the Selling Price of Products with Discount.
That’s right, our ClsVolume2 Class has all the necessary properties to enter the required Sales data values like Description, Quantity, Unit Price, and Discount Percentage, which will go into the Volume Class Properties strDesc, dblLength, dblWidth, and dblHeight respectively.
We should not forget that the ClsVolume2 Class is a Derived Class, built using ClsArea as Base Class.
ClsVolume2 Class Re-Visited.
But, first, the VBA Code of ClsVolume2 Class Module (the Base Class for our new ClsSales Class Module) is reproduced below for reference:
Option Compare Database Option Explicit Private p_Height As Double Private p_Area As ClsArea Public Property Get dblHeight() As Double dblHeight = p_Height End Property Public Property Let dblHeight(ByVal dblNewValue As Double) p_Height = dblNewValue End Property Public Function Volume() As Double Volume = CArea.dblLength * CArea.dblWidth * Me.dblHeight End Function Public Property Get CArea() As ClsArea Set CArea = p_Area End Property Public Property Set CArea(ByRef AreaValue As ClsArea) Set p_Area = AreaValue End Property Private Sub Class_Initialize() Set p_Area = New ClsArea End Sub Private Sub Class_Terminate() Set p_Area = Nothing End Sub
The only problem that prevents us from using ClsVolume2 Class directly to the Sales data entry is that the Property Procedure names dblLength, dblWidth, and dblHeight do not match for the Sales property values Quantity, Unit Price, Discount Percentage. The numeric data types of ClsVolume2 Class are all double precision numbers and they are suitable for our Sales-Class Object and can be used without data Type change. The public functions Area() and Volume() names are also not suitable, but their calculation formula can be used for Sales calculations without change.
a) Area = dblLength * dblWidth is suitable for TotalPrice = Quantity * UnitPrice
b) Volume = Area * dblHeight is good for DiscountAmount = TotalPrice * DiscountPercentage
Here, we have two choices to make use of the ClsVolume2 Class as ClsSales Class.
The easiest way is to make a copy of the ClsVolume2 Class and save it in a new class Module with the name ClsSales. Make appropriate changes to the Property Procedure and public Function names suitable for sales values and calculations. Add more functions, if required, in the new class module.
Create a Wrapper Class using ClsVolume2 as Base Class and create suitable property procedures and public function name changes, masking the Base Class’s Property Procedures and Function names. Create new Functions in the Wrapper Class, if necessary.
The first option is somewhat straightforward and easy to implement. But, we will select the second option to learn how to address the Base Class’s Properties in the new wrapper Class and how to mask its original property names with new ones.
The Transformed ClsVolume2 Class.
Open your Database and display the VBA Editing Window (Alt+F11).
Select the Class Module from Insert Menu, to insert a new Class Module.
Change the Class Module’s Name property Value from Class1 to ClsSales.
Copy and Paste the following VBA Code into the Module and Save the Code:
Option Compare Database Option Explicit Private m_Sales As ClsVolume2 Private Sub Class_Initialize() 'instantiate the Base Class in Memory Set m_Sales = New ClsVolume2 End Sub Private Sub Class_Terminate() 'Clear the Base Class from Memory Set m_Sales = Nothing End Sub Public Property Get Description() As String Description = m_Sales.CArea.strDesc 'Get from Base Class End Property Public Property Let Description(ByVal strValue As String) m_Sales.CArea.strDesc = strValue ' Assign to Base Class End Property Public Property Get Quantity() As Double Quantity = m_Sales.CArea.dblLength End Property Public Property Let Quantity(ByVal dblValue As Double) If dblValue > 0 Then m_Sales.CArea.dblLength = dblValue ' Assign to clsArea, Base Class of ClsVolume2 Else MsgBox "Quantity: " & dblValue & " Invalid.", vbExclamation, "ClsSales" Do While m_Sales.CArea.dblLength <= 0 m_Sales.CArea.dblLength = InputBox("Quantity:, Valid Value >0") Loop End If End Property Public Property Get UnitPrice() As Double UnitPrice = m_Sales.CArea.dblWidth End Property Public Property Let UnitPrice(ByVal dblValue As Double) If dblValue > 0 Then m_Sales.CArea.dblWidth = dblValue ' Assign to clsArea, Base Class of ClsVolume2 Else MsgBox "UnitPrice: " & dblValue & " Invalid.", vbExclamation, "ClsSales" Do While m_Sales.CArea.dblWidth <= 0 m_Sales.CArea.dblWidth = InputBox("UnitPrice:, Valid Value >0") Loop End If End Property Public Property Get DiscountPercent() As Double DiscountPercent = m_Sales.dblHeight End Property Public Property Let DiscountPercent(ByVal dblValue As Double) ' Assign to Class .dblHeight of ClsVolume2 Select Case dblValue Case Is <= 0 MsgBox "Discount % -ve Value" & dblValue & " Invalid!", vbExclamation, "ClsSales" Do While m_Sales.dblHeight <= 0 m_Sales.dblHeight = InputBox("Discount %, Valid Value >0") Loop Case Is >= 1 m_Sales.dblHeight = dblValue / 100 Case 0.01 To 0.75 m_Sales.dblHeight = dblValue End Select End Property Public Function TotalPrice() As Double Dim Q As Double, U As Double Q = m_Sales.CArea.dblLength U = m_Sales.CArea.dblWidth If (Q * U) = 0 Then MsgBox "Quantity / UnitPrice Value(s) 0", vbExclamation, "ClsVolume" Else TotalPrice = m_Sales.CArea.Area 'Get from Base Class ClsArea End If End Function Public Function DiscountAmount() As Double DiscountAmount = TotalPrice * DiscountPercent End Function Public Function PriceAfterDiscount() PriceAfterDiscount = TotalPrice - DiscountAmount End Function
What we already did, in the Wrapper Class? Created an instance of the ClsVolume2 Class and changed its Property Names, Function Names and added Validation checks with appropriate error messages and prevented from dropping into the validation check of the Base class with error messages like "Value of the dblLength property is invalid" may pop up from the Volume Class.
Check the lines I have highlighted in the above Code and I hope you will be able to figure out how the property values are assigned/retrieved to/from the Base Class ClsVolume2.
You may go through the ClsArea Class Module first and next to the ClsVolume2 Class Module – the derived Class using ClsArea Class as Base Class. After going through both these Codes you may take a second look at the Code in this Wrapper Class.
Test Program for ClsSales Class in Standard Module.
Let us write a Test Program to try out the Wrapper Class.
Copy and Paste the following VBA Code into a Standard Module.
Public Sub SalesTest() Dim S As ClsSales Set S = New ClsSales S.Description = "Micro Drive" S.Quantity = 12 S.UnitPrice = 25 S.DiscountPercent = 0.07 Debug.Print "Desccription", "Quantity", "UnitPrice", "Total Price", "Disc. Amt", "To Pay" With S Debug.Print .Description, .Quantity, .UnitPrice, .TotalPrice, .DiscountAmount, .PriceAfterDiscount End With End Sub
Run The Code.
Keep the Debug Window open (Ctrl+G).
Click somewhere in the middle of the Code and press the F5 key to Run the Code and to print the output in the Debug Window.
You may test the Code further by entering any of the input values with a Negative number and running the code to trigger the new Error Message. Disable any of the input lines, with a comment symbol ('), run the code, and see what happens.
Calculate Price/Discount for an Array of Products.
The following test code creates an array of three Products and Sales Values by entering directly from Keyboard.
Copy and Paste the following Code into a Standard Module and Run to test the Wrapper Class further.
Public Sub SalesTest2() Dim S() As ClsSales Dim tmp As ClsSales Dim j As Long For j = 1 To 3 Set tmp = New ClsSales tmp.Description = InputBox(j & ") Description") tmp.Quantity = InputBox(j & ") Quantity") tmp.UnitPrice = InputBox(j & ") UnitPrice") tmp.DiscountPercent = InputBox(j & ") Discount Percentage") ReDim Preserve S(1 To j) As ClsSales Set S(j) = tmp Set tmp = Nothing Next 'Output Section Debug.Print "Desccription", "Quantity", "UnitPrice", "Total Price", "Disc. Amt", "To Pay" For j = 1 To 3 With S(j) Debug.Print .Description, .Quantity, .UnitPrice, .TotalPrice, .DiscountAmount, .PriceAfterDiscount End With Next For j = 1 To 3 Set S(j) = Nothing Next End Sub
After the successful entry of correct values into the Array, the product names and sales values are printed in the Debug window.
CLASS MODULES.
Demo Database Download
- MS-Access Class Module and VBA
- MS-Access VBA Class Object Arrays
- MS-Access Base Class and Derived Objects
- VBA Base Class and Derived Objects-2
- Base Class and Derived Object Variants
- Ms-Access Recordset and Class Module
- Access Class Module and Wrapper Classes
- Wrapper Class Functionality Transformation
COLLECTION OBJECT.
- Ms-Access and Collection Object Basics
- Ms-Access Class Module and Collection Object
- Table Records in Collection Object and Form
I have been following the series of articles since its beginning and I implemented everything mentioned in it step by step and the work is going well until I reached this article, so I created the clsSales class, but when I try to execute SalesTest and SalesTest2 procedures, the cursor stops on the line (S.Description = "Micro Drive") and it appears to me The following error message
ReplyDeleteRun-time error '91':
Object variable or With block variable not set
I tried to review the code of the clsSales class and review everything that was previously explained in the series of articles, and I did not find anything wrong. Is the problem an error that I did not recognize in the code? or Is it a problem specific to my work environment?
I have been following the series of articles since its beginning and I implemented everything mentioned in it step by step and the work is going well until I reached this article, so I created the clsSales class, but when I try to execute SalesTest and SalesTest2 procedures, the cursor stops on the line (S.Description = "Micro Drive") and it appears to me The following error message
ReplyDeleteRun-time error '91':
Object variable or With block variable not set
I tried to review the code of the clsSales class and review everything that was previously explained in the series of articles, and I did not find anything wrong. Is the problem an error that I did not recognize in the code? or Is it a problem specific to my work environment?
I have been following the series of articles since its beginning and I implemented everything mentioned in it step by step and the work is going well until I reached this article, so I created the clsSales class, but when I try to execute SalesTest and SalesTest2 procedures, the cursor stops on the line (S.Description = "Micro Drive") and it appears to me The following error message
ReplyDeleteRun-time error '91':
Object variable or With block variable not set
I tried to review the code of the clsSales class and review everything that was previously explained in the series of articles, and I did not find anything wrong. Is the problem an error that I did not recognize in the code? or Is it a problem specific to my work environment?
This comment has been removed by the author.
ReplyDeleteI created a Database with the VBA Code given in this Page and run them successfully in the attached sample WrapperClass.accdb Database. The Database is attached to this Page in ZIP File Format with the name WrapperClass.Zip. Please download and try it out in your Access Verion.
ReplyDeleteIf it runs successfully, then compare your VBA Code with the Demo Database Code to find out what went wrong.
Regards,
It works successfully, thank you
DeleteI will try to compare the codes and look for the reason for the error.
The reason for the error is that the Class_Initialize and Class_Terminate property procedures were not created for the ClsVolume2 class.
ReplyDelete